home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / MSNP12_VB_2047842142007.psc / MSNP12 VB / Modules / modSSL.bas < prev    next >
BASIC Source File  |  2007-02-12  |  2KB  |  52 lines
  1. Attribute VB_Name = "modSSL"
  2. Public SSL As WinHttp.WinHttpRequest
  3.  
  4. Public Function SetHTTPLib()
  5.     Set SSL = Nothing
  6.     Set SSL = New WinHttp.WinHttpRequest
  7.     SSL.Option(WinHttpRequestOption_EnableRedirects) = False
  8. End Function
  9.  
  10. Public Function SendRecvSSL(Method As String, Data As String, _
  11.     Optional ReqHeaderN As String, Optional ReqHeaderD As String) As String
  12.     SSL.Open Method, Data
  13.     If ReqHeaderN <> "" And ReqHeaderD <> "" Then SSL.SetRequestHeader ReqHeaderN, ReqHeaderD
  14.     SSL.Send
  15.     SendRecvSSL = SSL.STATUS & " " & SSL.StatusText & vbCrLf & _
  16.     SSL.GetAllResponseHeaders
  17. End Function
  18.  
  19. Public Function pKey(AuthKey As String, User As String, Pass As String) As String
  20.     Dim sData As String, sLoginServ As String, sHeader As String
  21.     Call SetHTTPLib
  22.     sHeader = "Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" & _
  23.     Replace$(User, "@", "%40") & ",pwd=" & URLEncode(Pass) & "," & AuthKey
  24.             
  25.     sData = SendRecvSSL("GET", "https://nexus.passport.com/rdr/pprdr.asp")
  26.     If GetBetween(sData, , vbCrLf) = "200 OK" Then
  27.     sLoginServ = "https://" & GetBetween(sData, "DALogin=", ",")
  28.         
  29. ConnectionSSL:
  30.         
  31.         sData = SendRecvSSL("GET", sLoginServ, "Authorization", sHeader)
  32.         
  33.         Select Case GetBetween(sData, , vbCrLf)
  34.             Case "302 Found"
  35.                 sLoginServ = GetBetween(sData, "Location: ", vbCrLf)
  36.                 GoTo ConnectionSSL
  37.             Case "401 Unauthorized"
  38.                 MsgBox "Wrong username / password!": frmMain.sckNS.Close
  39.             Case "200 OK"
  40.                 pKey = GetBetween(sData, "from-PP='", "'")
  41.             Case Else
  42.                 MsgBox "Received unknown packet from SSL!": frmMain.sckNS.Close
  43.         End Select
  44.     Else
  45.     MsgBox "Could not retrieve data from SSL!": frmMain.sckNS.Close
  46.     End If
  47. End Function
  48.  
  49.  
  50.  
  51.  
  52.